Mammary FACS Notebook

Specify the tissue of interest, run the boilerplate code which sets up the functions and environment, load the tissue object.

tissue_of_interest = "Mammary"
library(here)
source(here("00_data_ingest", "02_tissue_analysis_rmd", "boilerplate.R"))
tiss <- load_tissue_facs(tissue_of_interest)

Performing log-normalization
0%   10   20   30   40   50   60   70   80   90   100%
|----|----|----|----|----|----|----|----|----|----|
**************************************************|

[1] "Scaling data matrix"

  |                                                                                                                                
  |                                                                                                                          |   0%
  |                                                                                                                                
  |==========================================================================================================================| 100%

Calculating gene means
0%   10   20   30   40   50   60   70   80   90   100%
|----|----|----|----|----|----|----|----|----|----|
**************************************************|
Calculating gene variance to mean ratios
0%   10   20   30   40   50   60   70   80   90   100%
|----|----|----|----|----|----|----|----|----|----|
**************************************************|

Later on (in FindClusters and TSNE) you will pick a number of principal components to use. This has the effect of keeping the major directions of variation in the data and, ideally, supressing noise. There is no correct answer to the number to use, but a decent rule of thumb is to go until the plot plateaus.

PCElbowPlot(object = tiss)

Choose the number of principal components to use.

# Set number of principal components. 
n.pcs = 14

The clustering is performed based on a nearest neighbors graph. Cells that have similar expression will be joined together. The Louvain algorithm looks for groups of cells with high modularity–more connections within the group than between groups. The resolution parameter determines the scale…higher resolution will give more clusters, lower resolution will give fewer.

For the top-level clustering, aim to under-cluster instead of over-cluster. It will be easy to subset groups and further analyze them below.

# Set resolution 
res.used <- 0.5
tiss <- FindClusters(object = tiss, reduction.type = "pca", dims.use = 1:n.pcs, 
    resolution = res.used, print.output = 0, save.SNN = TRUE)

To visualize

# If cells are too spread out, you can raise the perplexity. If you have few cells, try a lower perplexity (but never less than 10).
tiss <- RunTSNE(object = tiss, dims.use = 1:n.pcs, seed.use = 10, perplexity=30)

# note that you can set do.label=T to help label individual clusters
TSNEPlot(object = tiss, do.label = T)

Check expression of genes of interset.

Dotplots let you see the intensity of exppression and the fraction of cells expressing for each of your genes of interest.

How big are the clusters?

table(tiss@ident)

  0   1   2   3   4   5   6   7   8 
563 411 406 342 291 167 149  47  29 

Which markers identify a specific cluster?

#clust.markers <- FindMarkers(object = tiss, ident.1 = 3, only.pos = TRUE, min.pct = 0.25, thresh.use = 0.25)

print(x = head(x= clust.markers, n = 10))

You can also compute all markers for all clusters at once. This may take some time.

#tiss.markers <- FindAllMarkers(object = tiss, only.pos = TRUE, min.pct = 0.25, thresh.use = 0.25)

Display the top markers you computed above.

#tiss.markers %>% group_by(cluster) %>% top_n(5, avg_diff)

Assigning cell type identity to clusters

At a coarse level, we can use canonical markers to match the unbiased clustering to known cell types:

# stash current cluster IDs
tiss <- StashIdent(object = tiss, save.name = "cluster.ids")
# enumerate current cluster IDs and the labels for them
cluster.ids <- c(0, 1, 2, 3, 4, 5, 6, 7, 8)
free_annotation <- c("basal cell", "luminal progenitor", "basal cell", "basal cell", "stromal cell",
                     "mature luminal cell", "stromal cell", "endothelial cell", "basal cell")
cell_ontology_class <-c("basal cell", "luminal epithelial cell of mammary gland", "basal cell", "basal cell", "stromal cell", "luminal epithelial cell of mammary gland", "stromal cell",
                         "endothelial cell", "basal cell")
validate_cell_ontology(cell_ontology_class)
cell_ontology_id = convert_to_cell_ontology_id(cell_ontology_class)
tiss@meta.data['free_annotation'] <- as.character(plyr::mapvalues(x = tiss@ident, from = cluster.ids, to = free_annotation))
validate_cell_ontology(cell_ontology_class)
cell_ontology_id = convert_to_cell_ontology_id(cell_ontology_class)
tiss@meta.data[,'free_annotation'] <- plyr::mapvalues(x = tiss@ident, from = cluster.ids, to = free_annotation)
tiss@meta.data[,'cell_ontology_class'] <- plyr::mapvalues(x = tiss@ident, from = cluster.ids, to = cell_ontology_class)
tiss@meta.data[,'cell_ontology_id'] <- plyr::mapvalues(x = tiss@ident, from = cluster.ids, to = cell_ontology_id)

Checking for batch effects

Color by metadata, like plate barcode, to check for batch effects.

Print a table showing the count of cells in each identity category from each plate.

table(as.character(tiss@ident), as.character(tiss@meta.data$plate.barcode))

   
    B000166 B000167 B000168 B002309 B002432 B002433 B002435 B002436 B002437 B002438
  0       7       5      14      67     101     116      26      27      63     137
  1      44      46      22      33      53      53      38      45      28      49
  2      78     125      80      54      14      10      14      29       1       1
  3       8       9       7      10      27      30      85     111      44      11
  4      18      11       8      21      43      48      22      44      26      50
  5      13       7      19      18      22      18      11      25      13      21
  6       3       6       7       3      24      21      22      28      16      19
  7       3       4       1       9       9       8       5       2       1       5
  8       0       0       1       3      11       5       1       1       0       7

Subcluster

Additional subclustering on Basal cells did not turn up definitive subtypes.

subtiss = SubsetData(tiss, ident.use = c(0, 2, 3, 8))

subtiss <- subtiss %>% ScaleData() %>% 
  FindVariableGenes(do.plot = TRUE, x.high.cutoff = Inf, y.cutoff = 0.5) %>%
  RunPCA(do.print = FALSE)

subtiss@hvg.info

PCHeatmap(object = subtiss, pc.use = 1:3, cells.use = 500, do.balanced = TRUE, label.columns = FALSE, num.genes = 8)
PCElbowPlot(subtiss)

PCAPlot(subtiss)

sub.n.pcs = 10
sub.res.use = 1
subtiss <- subtiss %>% FindClusters(reduction.type = "pca", dims.use = 1:sub.n.pcs, 
    resolution = sub.res.use, print.output = 0, save.SNN = TRUE) %>%
    RunTSNE(dims.use = 1:sub.n.pcs, seed.use = 10, perplexity=20)

TSNEPlot(object = subtiss, do.label = T, pt.size = 1.2, label.size = 4)

VlnPlot(subtiss, "Car3")

cluster_8 <- FindMarkers(subtiss, ident.1 = 8, test = "roc")

cluster_8

clust_8_genes = c('Lgals3', 'Ly6d', 'S100a14', "Smoc2")

VlnPlot(subtiss, clust_8_genes)

Save the Robject for later

filename = here('00_data_ingest', '04_tissue_robj_generated', 
                     paste0("facs_", tissue_of_interest, "_seurat_tiss.Robj"))
print(filename)

[1] "/Users/josh/src/tabula-muris/00_data_ingest/04_tissue_robj_generated/facs_Mammary_seurat_tiss.Robj"

save(tiss, file=filename)

# To reload a saved object
# filename = here('00_data_ingest', '04_tissue_robj_generated', 
#                      paste0("facs", tissue_of_interest, "_seurat_tiss.Robj"))
# load(file=filename)

Export the final metadata

filename = here('00_data_ingest', '03_tissue_annotation_csv', 
                     paste0(tissue_of_interest, "_annotation.csv"))
write.csv(FetchData(tiss, c('plate.barcode','cell_ontology_class','cell_ontology_id', 'free_annotation', 'tSNE_1', 'tSNE_2')), file=filename)